home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1989 March
/
1989-03.d64
/
monthly calendar
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
8KB
|
313 lines
100 rem copyright 1988 compute! publications, inc. - all rights reserved
110 lc$=chr$(14):re$=chr$(15):gm$=chr$(8):nr=7
120 dim cm(255)
130 dimmo$(12),ld(12),da$(60),ms$(50,nr+1),dd$(2,60),l$(20),ml$(18),c(255)
140 sp$=" ":fori=0to5:sp$=sp$+sp$:next:sp$=left$(sp$,31):ss$=left$(sp$,10)
150 poke53280,15:poke53281,11
160 print"[155][147]"
170 printtab(11)"monthly calendar "
190 printtab(11)" copyright 1989 "
200 printtab(7)"compute! publications, inc."
210 printtab(10)"all rights reserved"
220 fori=27 to 127:cm(i)=1:cm(i+128)=1:next
230 i=2
240 read a:if a=-1 then270
250 cm(a)=i:i=i+1:goto240
260 data 17,145,29,157,147,13,19,20,148,95,-1
270 i=0
280 read a$
290 t=asc(left$(a$,1)):c(t)=i+1
300 a$(i)=chr$(49+i)+" "+chr$(t)+"[146]"+right$(a$,len(a$)-1)
310 i=i+1:if a$<>"quit" then280
320 data "new calendar","year and month",memo,"enhance dates",print,save,load
330 data quit
340 forh=1to12:readmo$(h),ld(h):nexth
350 n4=i-1
360 fori=0 to n4:print:printspc(12) a$(i):next
370 geta$:if a$="" then370
380 a2=asc(a$):if c(a2) then a2=c(a2):goto410
390 v=val(a$):if v>0 and v<=i then a2=v:goto410
400 goto370
410 on a2 gosub3070,450,2170,1430,920,2310,2500,2070
420 print"[147]":goto360
430 print"[147]":if yr$="" then print"choose year and month first":gosub460:goto430
440 return
450 print"[147]"
460 print"enter calendar year: ";
470 input t$
480 if t$="" then return
490 if val(t$)<100 or val(t$)>9999then goto450
500 yr$=t$:y=val(yr$)
510 print"[147]"
520 print"select month(1-12)"
530 fori=1to9:printtab(10)"[144]"i"[155]"mo$(i):next
540 fori=10to12:printtab(9)"[144]"i"[155]"mo$(i):next
550 input"enter month";nu$
560 nu=val(nu$):ifnu>=1andnu<=12thenhh=0:goto610
570 fori=1to12
580 ifnu$=mo$(i)thennu=i:hh=0:goto610
590 nexti
600 goto520
610 rem calculations
620 ld(2)=28:gosub2080
630 a=(y/100):b=int(y/100):c=a-b
640 ifc=0then680
650 a=(y/4):b=int(y/4):c=a-b
660 ifc=0thenad=1:goto710
670 ad=0:goto710
680 a=(y/400):b=int(y/400):c=a-b
690 ifc=0thenad=1:goto710
700 ad=0:goto710
710 a=int(y/4):b=int(y/400):c=int(y/100):d=a+b-c
720 e=(y+d)/7:f=int((y+d)/7):g=(e-f)*7:sd=int(g):h=g-sd
730 ifh>.9thensd=sd+1
740 sd=sd-ad
750 ifsd<0thensd=sd+7
760 onnugosub1310,1320,1330,1340,1350,1360,1370,1380,1390,1400,1410,1420
770 ifds>6thends=ds-7
780 ifds<0thends=ds+7
790 d=0:ifflag=1thenflag=0:goto810
800 ifhh<>0thenreturn
810 fori=1to50
820 ifi-ds<=0thenda$(i)="":goto850
830 ifi-ds>ld(nu)thenda$(i)="":goto850
840 da$(i)=str$(i-ds):da$(i)=right$(da$(i),len(da$(i))-1)
850 nexti
860 ifds=0andld(nu)=28thenr=4:goto890
870 ifda$(36)=""thenr=5:goto890
880 r=6
890 hd$=mo$(nu)+" "+yr$
900 cs=int((40-len(hd$))/2)
910 return
920 gosub430:if a2<>5 then950
930 t$="include memo bar in print out":gosub3030
940 mb$="n":if q then mb$="y"
950 print"[147]make sure printer is on..."
960 print"_ for menu, any other key to print"
970 getch$:ifch$=""then970
980 if ch$="_" then return
990 gosub2100:close5:open5,4,6:open4,4:print#4,lc$;tab(cs)hd$;re$;
1000 print#4:print#5,chr$(20)
1010 print#4,"[176][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192]";
1020 print#4,"[192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][174]";gm$
1030 print#4,re$;"[221]sunday [221]monday [221]tuesday [221]wednesday [221]thursday ";
1040 print#4,"[221]friday [221]saturday [221]";gm$
1050 gosub1280
1060 fori=1tor
1070 gosub1280
1080 print#4,re$;
1090 forz=1to7:tb=(z)*11:tb$=str$(tb):tb$=right$(tb$,2)
1100 print#4,"[221]";lc$;da$(d+z);re$;chr$(16)+tb$;
1110 next z
1120 print#4,chr$(16)+"77";"[221]";gm$
1130 print#4,re$;:d7=d-ds
1140 fortt=1tonr
1150 fort=1to7:tb=(t)*11:tb$=str$(tb):tb$=right$(tb$,2)
1160 d8=d7+t:if d8<0 or d8>31 then t$=ss$:goto1180
1170 t$=ms$(d7+t,tt-1)
1180 print#4,"[221]";t$;chr$(16)+tb$;
1190 next t
1200 print#4,chr$(16)+"77";"[221]";gm$
1210 print#4,re$;
1220 next tt
1230 d=d+7:nexti
1240 ifmb$="n"then2120
1250 print#4,re$;"[171][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192]";
1260 print#4,"[192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][179]"gm$
1270 close4,4:goto1700
1280 print#4,re$;"[171][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192]";
1290 print#4,"[192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][179]";gm$
1300 return
1310 ds=sd:return
1320 ds=sd+3:ld(nu)=ld(nu)+ad:return
1330 ds=sd+3+ad:return
1340 ds=sd-1+ad:return
1350 ds=sd+1+ad:return
1360 ds=sd+4+ad:return
1370 ds=sd-1+ad:return
1380 ds=sd+2+ad:return
1390 ds=sd+5+ad:return
1400 ds=sd+ad:return
1410 ds=sd+3+ad:return
1420 ds=sd+5+ad:return
1430 rem enhance dates
1440 print"[147]":if yr$="" then print"choose year and month first":gosub460
1450 du=0:print"[147][155]";
1460 printhd$
1470 print"sun mon tue wed thu fri sat"
1480 foru=0to5
1490 foruu=1to7
1500 do=(uu-1)*5:printtab(do)da$(uu+du);
1510 t=u*7+uu
1520 nextuu
1530 print"":du=du+7
1540 nextu
1550 print" input 'q' when finished enhancing dates":input "enter date";md$
1560 if md$="q" or md$="[209]" then return
1570 md=val(md$)
1580 ifmd<1 or md>ld(nu)thenprint"[145][145][145][145]":goto1550
1590 pr$="[147]enter message for[144] "+mo$(nu)+ " "+str$(md)+"[155]"
1600 b$="":h=nr:w=10
1610 for i=0 to nr
1620 t$=ms$(md,i):if len(t$)<>w then t$=ss$
1630 b$=b$+t$
1640 next
1650 gosub2630:j=0
1660 for i=1 to h*w+1 step w
1670 ms$(md,j)=mid$(b$,i,w):j=j+1
1680 next
1690 goto1450
1700 ifnu=1thenn1=12:n2=2:y(1)=y-1:y(2)=y:goto1730
1710 ifnu=12thenn1=11:n2=1:y(1)=y:y(2)=y+1:goto1730
1720 n1=nu-1:n2=nu+1:y(1)=y:y(2)=y
1730 nu=n1:y=y(1):hh=1:ch=1:d=0
1740 gosub620
1750 d=0
1760 fori=1to50
1770 ifi-ds<=0thendd$(hh,i)=" ":goto1810
1780 ifi-ds>ld(nu)thendd$(hh,i)=" ":goto1810
1790 ifi-ds<10thendd$(hh,i)=" "+str$(i-ds):goto1810
1800 dd$(hh,i)=str$(i-ds)
1810 nexti:hd$(hh)=mo$(nu)+" "+str$(y(hh)):cs(hh)=int((22-len(hd$(hh)))/2)
1820 ifhh=2thencs(hh)=cs(hh)+56
1830 cs$(hh)=str$(cs(hh)):cs$(hh)=right$(cs$(hh),2)
1840 ifhh=1thenhh=2:nu=n2:y=y(2):gosub620:goto1750
1850 l$(1)="[221]"+chr$(16)+"22[221]"+chr$(16)+"55[221]"+chr$(16)+"77[221]"
1860 l$(2)="[221]"+chr$(16)+cs$(1)+hd$(1)+chr$(16)+"22[221]"+lc$+" memos"+re$
1870 l$(2)=l$(2)+chr$(16)+"55[221]"+chr$(16)+cs$(2)+hd$(2)+chr$(16)+"77[221]"
1880 l$(3)=l$(1)
1890 l$(4)="[221] su mo tu we th fr sa[221]"
1900 l$(4)=l$(4)+chr$(16)+"55[221] su mo tu we th fr sa[221]"
1910 l$(5)=l$(1):j=6
1920 fori=6to18step2
1930 l$(i)="[221]"
1940 forii=1to7
1950 l$(i)=l$(i)+dd$(1,ii+d)
1960 nextii
1970 t$=ml$(j):if len(t$)<31 then t$=sp$:ml$(j)=sp$
1980 l$(i)=l$(i)+chr$(16)+"22[221] "+t$+"[221]":j=j+1
1990 forii=1to7:l$(i)=l$(i)+dd$(2,d+ii):nextii
2000 l$(i)=l$(i)+chr$(16)+"77[221]"
2010 l$(i+1)=l$(1)
2020 d=d+7:nexti
2030 l$(18)="[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
2040 l$(18)=l$(18)+"[192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
2050 gosub2100:open4,4:fori=1to18:print#4,re$;l$(i);gm$:nexti
2060 close4,4:y=val(yr$):nu=val(nu$):gosub620:return
2070 poke 53280,14:poke53281,6:print"[147][154]";:clr:end
2080 print"[147][144]calculating...[155]"
2090 return
2100 print"[147]printing[146]...(press run/stop to abort)[155]"
2110 return
2120 print#4,re$;"[173][192][192][192][192][192][192][